home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / By the Book / Mac Pascal Primer, 4.0 / Chap 7, ShowClip ƒ / ShowClip.p next >
Text File  |  1990-06-22  |  2KB  |  102 lines
  1. program ShowClip;
  2.     const
  3.         BASE_RES_ID = 400;
  4.         ERROR_ALERT_ID = BASE_RES_ID + 1;
  5.         NO_WIND = BASE_RES_ID;
  6.         EMPTY_SCRAP = BASE_RES_ID + 1;
  7.  
  8.         NIL_STRING = '';
  9.         HOPELESSLY_FATAL_ERROR = 'Game over, man!';
  10.  
  11.     var
  12.         gClipWindow: WindowPtr;
  13.  
  14.  
  15. {-------------------------------->    ErrorHandler    <---}
  16.  
  17.     procedure ErrorHandler (stringNum: INTEGER);
  18.         var
  19.             errorStringH: StringHandle;
  20.             dummy: INTEGER;
  21.     begin
  22.         errorStringH := GetString(stringNum);
  23.         if errorStringH = nil then
  24.             ParamText(HOPELESSLY_FATAL_ERROR, NIL_STRING, NIL_STRING, NIL_STRING)
  25.         else
  26.             ParamText(errorStringH^^, NIL_STRING, NIL_STRING, NIL_STRING);
  27.  
  28.         dummy := StopAlert(ERROR_ALERT_ID, nil);
  29.         ExitToShell;
  30.     end;
  31.  
  32.  
  33. {-------------------------------->    CenterPict    <---}
  34.  
  35.     procedure CenterPict (thePicture: PicHandle; var myRect: Rect);
  36.         var
  37.             windRect, pictureRect: Rect;
  38.     begin
  39.         windRect := myRect;
  40.         pictureRect := thePicture^^.picFrame;
  41.         myRect.top := (windRect.bottom - windRect.top - (pictureRect.bottom - pictureRect.top)) div 2 + windRect.top;
  42.         myRect.bottom := myRect.top + (pictureRect.bottom - pictureRect.top);
  43.         myRect.left := (windRect.right - windRect.left - (pictureRect.right - pictureRect.left)) div 2 + windRect.left;
  44.         myRect.right := myRect.left + (pictureRect.right - pictureRect.left);
  45.     end;
  46.  
  47.  
  48. {-------------------------------->    MainLoop    <---}
  49.  
  50.     procedure MainLoop;
  51.         var
  52.             myRect: Rect;
  53.             clipHandle: Handle;
  54.             length, offset: LONGINT;
  55.     begin
  56.         clipHandle := NewHandle(0);
  57.         length := GetScrap(clipHandle, 'TEXT', offset);
  58.         if length < 0 then
  59.             begin
  60.                 length := GetScrap(clipHandle, 'PICT', offset);
  61.                 if length < 0 then
  62.                     ErrorHandler(EMPTY_SCRAP)
  63.                 else
  64.                     begin
  65.                         myRect := gClipWindow^.portRect;
  66.                         CenterPict(PicHandle(clipHandle), myRect);
  67.                         DrawPicture(PicHandle(clipHandle), myRect);
  68.                     end;
  69.             end
  70.         else
  71.             begin
  72.                 HLock(clipHandle);
  73.                 TextBox(Ptr(clipHandle^), length, thePort^.portRect, teJustLeft);
  74.                 HUnlock(clipHandle);
  75.             end;
  76.  
  77.         while not Button do
  78.             begin
  79.             end;
  80.     end;
  81.  
  82.  
  83. {-------------------------------->    WindowInit    <---}
  84.  
  85.     procedure WindowInit;
  86.     begin
  87.         gClipWindow := GetNewWindow(BASE_RES_ID, nil, WindowPtr(-1));
  88.  
  89.         if gClipWindow = nil then
  90.             ErrorHandler(NO_WIND);
  91.  
  92.         ShowWindow(gClipWindow);
  93.         SetPort(gClipWindow);
  94.     end;
  95.  
  96.  
  97. {-------------------------------->    ShowClip    <---}
  98.  
  99. begin
  100.     WindowInit;
  101.     MainLoop;
  102. end.